home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 22
/
Amiga Format AFCD22 (Jan 1998, Issue 106).iso
/
-in_the_mag-
/
emulation
/
dcmtoimg
/
cvtdcm.p
< prev
next >
Wrap
Text File
|
1997-11-17
|
9KB
|
270 lines
program cvtDCM;
var multiExpected, notOpen, misMatch, done, err,
hasAddr, newStart, use: Boolean;
ch, letter: char;
header, code, densityCode, lo, hi, data, start, limit, fill: byte;
size, offs, numSecs, secNo, newSec, regX, i: integer;
count: longint;
a: file of byte;
b: file;
ATRheader: array[0..15] of byte;
fileName, inPathName, outPathName: string[64];
buffer, pad: array[0..127] of byte;
begin
for i := 0 to 127
do pad[i] := 0;
if ParamCount = 0
then begin
write('File name? ');
readln(fileName)
end
else fileName := ParamStr(1);
if pos('.', fileName) <> 0
then begin
writeln('''.'' not valid in file name!');
halt(20)
end;
outPathName := fileName;
size := length(fileName);
if pos('/', fileName) <> 0
then begin
i := size;
repeat
ch := fileName[i];
if ch <> '/'
then i := i - 1
until ch = '/';
outPathName := copy(filename, i + 1, size - i)
end;
multiExpected := false;
if size > 2
then if (UpCase(fileName[size - 1]) = 'F') and (fileName[size] = '1')
then begin
outPathName := copy(outPathName, 1, length(outPathName) - 2);
offs := size;
multiExpected := true
end;
inPathName := fileName + '.dcm';
secNo := 1;
numSecs := 720;
notOpen := true;
done := false;
repeat
assign(a, inPathName);
reset(a);
if eof(a)
then begin
if not multiExpected
then begin
writeln('File missing!');
err := true
end
else done := true
end
else begin
read(a, header);
count := 1;
misMatch := (multiExpected and (header = $FA))
or (not multiExpected and (header = $F9));
if misMatch
then begin
writeln('Input file header error!');
close(a);
halt(20)
end;
read(a, code);
count := count + 1;
densityCode := (code and $60) shr 5 + 1;
{
writeln('Density code is ', densityCode);
}
if (densityCode < 1) or (densityCode > 3)
then begin
writeln('Invalid density code!');
close(a);
if not notOpen
then close(b);
halt(20)
end;
if densityCode = 2
then begin
writeln('Can''t do double density yet!');
close(a);
if not notOpen
then close(b);
halt(20)
end;
read(a, lo, hi);
count := count + 2;
newSec := hi * 256 + lo;
if secNo <> newSec
then begin
writeln('Input file header error!');
close(a);
if not notOpen
then close(b);
halt(20)
end
err := false;
if notOpen
then begin
if densityCode = 3
then outPathName := outPathName + '.ATR'
else outPathName := outPathName + '.XFD';
assign(b, outPathName);
rewrite(b, 16);
if densityCode = 3
then begin
ATRheader[0] := $96;
ATRheader[1] := $02;
ATRheader[2] := 1040 mod 256;
ATRheader[3] := 1040 div 256;
ATRheader[4] := 128;
ATRheader[5] := 0;
for i := 6 to 15
do ATRheader[i] := 0;
BlockWrite(b, ATRheader, 1);
numsecs := 1040
end;
notOpen := false
end;
repeat
read(a, code);
count := count + 1;
hasAddr := (code and $80) = 0;
letter := chr(code and $7F);
{
writeln('Code is ''', letter, '''');
}
case letter of
'A': begin
read(a, start);
count := count + 1;
regX := start;
repeat
read(a, data);
count := count + 1;
buffer[regX] := data;
regX := regX - 1
until regX = - 1;
BlockWrite(b, buffer, 8);
secNo := secNo + 1
end;
'B': err := true;
'C': begin
regX := 0;
newStart := true;
repeat
if newStart
then begin
read(a, start);
count := count + 1;
{
writeln('Start=', start);
}
newStart := false
end;
if regX = start
then begin
read(a, limit, fill);
count := count + 2;
{
write('Limit=', limit, ' Fill=')
if (fill >= 32) and (fill <= 126)
then writeln('''', chr(fill), '''')
else writeln(fill);
}
for i := regX to regX + limit - start - 1
do buffer[i] := fill;
regX := regX + limit - start;
newStart := true
end
else begin
read(a, data);
count := count + 1;
buffer[regX] := data
regX := regX + 1
end
until regX = 128;
BlockWrite(b, buffer, 8);
secNo := secNo + 1
end;
'D': begin
read(a, start);
count := count + 1;
regX := start;
repeat
read(a, data);
count := count + 1;
buffer[regX] := data;
regX := regX + 1
until regX = 128;
BlockWrite(b, buffer, 8);
secNo := secNo + 1
end;
'E': begin
read(a, data, data);
count := count + 2;
if eof(a)
then hasAddr := false
end;
'F': begin
BlockWrite(b, buffer, 8);
secNo := secNo + 1
end;
'G': begin
for i := 0 to 127
do begin
read(a, buffer[i]);
count := count + 1
end;
BlockWrite(b, buffer, 8);
secNo := secNo + 1
end
else err := true
end;
if hasAddr and not err
then begin
read(a, lo, hi);
count := count + 2;
newSec := hi * 256 + lo;
if (newSec <> 69) and (newSec < numSecs)
then begin
{
writeln('Current sector = ', secNo, ' new sector = ', newSec);
}
if newSec > secNo
then begin
for i := secNo to newSec - 1
do BlockWrite(b, pad, 8);
secNo := newSec
end
end
else {writeln(newSec, ' ignored!')}
end
until err or eof(a);
close(a)
end;
if err
then writeln('Sector = ', count div 512 + 1,
' Offset = ', count mod 512)
else if not done
then if multiExpected
then begin
inPathName[offs] := chr(ord(inPathName[offs]) + 1)
{
writeln('offset=',offs)
writeln('''',inPathName,'''')
}
end
else done := true
until done or err;
if not err
then if secNo < numSecs
then for i := secNo to numSecs
do BlockWrite(b, pad, 8)
close(b)
end.